files:
Empirics_JPE_MS20210421.R is copy of Empirics_PZ_oos_27June2022_due copy.R
Montecarlo_JPE_MS20210421.R is copy of Montecarlo_Copiadi_27June2022.R
Montecarlo_locallyweak_JPE_MS20210421.R is copy of   locallyweakfactor_montecarlo.R
Montecarlo_numberoffactors_JPE_MS20210421 is copy of new_version_dec22.R
Instructions_JPE_MS20210421.R is copy of Instructions_code_nov24_copiadibozza_15dec2022.R

MAIN MANUSCRIPT

Table 1: run 1 to 1910 of Montecarlo_JPE_ MS20210421.R


Table 2:  Montecarlo_locallyweak_JPE_ MS20210421


Table 3:   Empirics_JPE_ MS20210421.R


Out-of-Sample  SDF
abs(apply(dmSS_uncond_bal_oos[,(Thalf-window+2):(nw-window)],1,mean)/apply(dmSS_cond_bal_oos[,(Thalf-window+2):(nw-window)],1,mean))
mean(abs(apply(dmSS_uncond_bal_oos[,(Thalf-window+2):(nw-window)],1,mean)/(matrix(rep(1,10),10,1)%*%mean(dmSS_cond_bal_oos_opt[,(Thalf-window+2):(nw-window)]))))
abs(apply(dmSS_uncond_bal_oos[,(Thalf-window+2):(nw-window)],1,mean)/apply(dmSS_cond_unbal_oos[,(Thalf-window+2):(nw-window)],1,mean))
mean(abs(apply(dmSS_uncond_bal_oos[,(Thalf-window+2):(nw-window)],1,mean)/(matrix(rep(1,10),10,1)%*%mean(dmSS_cond_unbal_oos_opt[,(Thalf-window+2):(nw-window)]))))
In-Sample SDF
apply(dmSS_uncond_bal_is[,(Thalf-window+2):409],1,mean)/apply(dmSS_cond_bal_is[,(Thalf-window+2):409],1,mean)
abs(apply(dmSS_uncond_bal_is[,(Thalf-window+2):(nw-2*window)],1,mean)/matrix(rep(1,10),10,1)%*%mean(dmSS_cond_bal_is_opt[1,(Thalf-window+2):(nw-2*window)]))
apply(dmSS_uncond_bal_is[,(Thalf-window+2):409],1,mean)/apply(dmSS_cond_unbal_is[,(Thalf-window+2):409],1,mean)
abs(apply(dmSS_uncond_bal_is[,(Thalf-window+2):(nw-2*window)],1,mean)/matrix(rep(1,10),10,1)%*%mean(dmSS_cond_unbal_is_opt[1,(Thalf-window+2):(nw-2*window)]))
Out-of-Sample  RP
abs(apply(dmSS_delta_uncond_bal_oos[,(Thalf-window+2):(nw-window)],1,mean)/apply(dmSS_delta_cond_bal_oos_45[,(Thalf-window+2):(nw-window)],1,mean))
mean(abs(apply(dmSS_delta_uncond_bal_oos[,(Thalf-window+2):(nw-window)],1,mean)/(matrix(rep(1,10),10,1)%*%mean(dmSS_delta_cond_bal_oos_45_opt[,(Thalf-window+2):(nw-window)])))
abs(apply(dmSS_delta_uncond_bal_oos[,(Thalf-window+2):(nw-window)],1,mean)/apply(dmSS_delta_cond_unbal_oos_45[,(Thalf-window+2):(nw-window)],1,mean))
mean(abs(apply(dmSS_delta_uncond_bal_oos[,(Thalf-window+2):(nw-window)],1,mean)/(matrix(rep(1,10),10,1)%*%mean(dmSS_delta_cond_bal_oos_45_opt[,(Thalf-window+2):(nw-window)])))
In-Sample RP
apply(dmSS_delta_uncond_bal_is[,(Thalf-window+2):409],1,mean)/apply(dmSS_delta_cond_bal_is_45[,(Thalf-window+2):409],1,mean)
abs(apply(dmSS_delta_uncond_bal_is[,(Thalf-window+2):(nw-2*window)],1,mean)/matrix(rep(1,10),10,1)%*%mean(dmSS_delta_cond_bal_is_45_opt[1,(Thalf-window+2):(nw-2*window)]))
apply(dmSS_delta_uncond_bal_is[,(Thalf-window+2):409],1,mean)/apply(dmSS_delta_cond_unbal_is_45[,(Thalf-window+2):409],1,mean)
abs(apply(dmSS_delta_uncond_bal_is[,(Thalf-window+2):(nw-2*window)],1,mean)/matrix(rep(1,10),10,1)%*%mean(dmSS_delta_cond_unbal_is_45_opt[1,(Thalf-window+2):(nw-2*window)]))

ONLINE APPENDIX

FIG OA1:
# number of stocks
 ts.nstocks24=ts.nstocks

#ns120 <- hist(ts.nstocks120, breaks = 30 , freq= FALSE)
ns24 <- hist(ts.nstocks24, breaks = 30 ,  freq=FALSE)


pdf('T24_number of stocksK7_9Jan23.pdf')
plot(ns24,  main="
            Number of Stocks  Unbalanced Panel (T=24)",xlim=c(0,3300),
     xlab="number of stocks",col = 2 , freq = FALSE) # Plot 1st histogram using a transparent color
abline(v=283, col=1,lwd=3) 
legend(500,0.001,c("unbalanced", "balanced"), lwd=c(5,5), col=c(2,1), y.intersp=0.75)
dev.off()


pdf('T120_number of stocksK7_9Jan23.pdf')
plot(ns120,  main="
            Number of Stocks  Unbalanced Panel (T=120)",xlim=c(0,1500),
     xlab="number of stocks",col = 2 , freq = FALSE) # Plot 1st histogram using a transparent color
abline(v=283, col=1,lwd=3) 
legend(500,0.008,c("unbalanced", "balanced"), lwd=c(5,5), col=c(2,1), y.intersp=0.75)
dev.off()


FIG OA2:
go to section  # input for conditional
of Empirics_JPE_MS20210421.R 

FIG OA3-OA6:
go to section # Canonical  Correlations
of Empirics_JPE_MS20210421.R 

# informal plot
aaa=seq(1:nw)
ylim = c(0,1)
plot(x = ts.enddate, y =matrix(ei10M[,1],ncol=1), type = "l", main = "Canonical Correlation: Loadings", xlab = "Date", ylab = "Pricing Performance", ylim = ylim)
lines(x  =ts.enddate, y = ei10M[,2],col=2)
lines(x  =ts.enddate, y = ei10M[,3],col=3)
lines(x  =ts.enddate, y = ei10M[,4],col=4)

# formal plot
pdf('T24_GC_LOADINGS.pdf')
plot(x=ts.enddate,y =matrix(ei10M[,1],ncol=1),type="l",ylim=c(0,1),
     main="Canonical Correlations: Factors \n local PCA vs constant PCA (T=24)" ,
     xlab="Date",ylab="Canonical Correlation"
) # Add 2nd histogram using different color
lines(x=ts.enddate,y=ei10M[,2],col=2)
lines(x=ts.enddate,y=ei10M[,3],col=2)
lines(x=ts.enddate,y=ei10M[,4],col=2)
lines(x=ts.enddate,y=ei10M[,5],col=2)
abline(v = rec[which(rec > 0)], col = "grey80")
legend(ts.enddate[241],0.6,c("gc=1", "gc=2","gc=3","gc=4","gc=5","econ-fin crises"), lwd=c(5,5), col=c(1,2,3,4,5,"grey"), y.intersp=0.75)
dev.off()



#informal

aaa=seq(1:nw)
ylim = c(0,1)
plot(x = ts.enddate, y =matrix(eis[,1],ncol=1), type = "l", main = "Pricing performance PCA", xlab = "Date", ylab = "Pricing Performance", ylim = ylim)
lines(x  =ts.enddate, y = eis[,1],col=2)
lines(x  =ts.enddate, y = eis[,3],col=3)
lines(x  =ts.enddate, y = eis[,4],col=4)
#lines(x  =ts.enddate, y = eis[,5],col=5)



# formal
pdf('T24_GC_LOADINGS_STATE4.pdf')
plot(x=ts.enddate,y=eis[,1],type="l",ylim=c(0,1),
     main="Canonical Correlations: Loadings \n local PCA vs state variables  (T=24)" ,
     xlab="Date",ylab="Canonical Correlation" )
lines(x=ts.enddate,y=eis[,2],col=2)
lines(x=ts.enddate,y=eis[,3],col=3)
lines(x=ts.enddate,y=eis[,4],col=4)
#lines(x=ts.enddate,y=ei10FF[,5],col=5)
abline(v = rec[which(rec > 0)], col = "grey80")
legend(ts.enddate[241],0.6,c("gc=1", "gc=2","gc=3","gc=4","econ-fin crises"), lwd=c(5,5), col=c(1,2,3,4,"grey"), y.intersp=0.75)
dev.off()






#informal 
aaa=seq(1:nw)
ylim = c(0,1)
#plot(x = ts.enddate, y = sdfT, type = "l", main = "Pricing performance PCA", xlab = "Date", ylab = "Pricing Performance", ylim = ylim)
plot(x = ts.enddate, y =matrix(ei10f[,1],ncol=1), type = "l", main = "Pricing performance PCA", xlab = "Date", ylab = "Pricing Performance", ylim = ylim)

## for (i in c(2:nrow(PP.lambda), 1)) lines(x = ts.enddate, y = PP.lambda[i,], col = i)
lines(x  =ts.enddate, y = ei10f[,2],col=2)
lines(x  =ts.enddate, y = ei10f[,3],col=3)
lines(x  =ts.enddate, y = ei10f[,4],col=4)
lines(x  =ts.enddate, y = ei10f[,5],col=5)

# formal
pdf('T24_GC_FACTORS.pdf')
plot(x=ts.enddate,y=ei10f[,1],type="l",ylim=c(0,1),
     main="Canonical Correlations: Factors \n local PCA vs constant PCA (T=24)" ,
     xlab="Date",ylab="Canonical Correlation" )
lines(x=ts.enddate,y=ei10f[,2],col=2)
lines(x=ts.enddate,y=ei10f[,3],col=3)
lines(x=ts.enddate,y=ei10f[,4],col=4)
lines(x=ts.enddate,y=ei10f[,5],col=5)
abline(v = rec[which(rec > 0)], col = "grey80")
legend(ts.enddate[241],0.6,c("gc=1", "gc=2","gc=3","gc=4","gc=5","econ-fin crises"), lwd=c(5,5), col=c(1,2,3,4,5,"grey"), y.intersp=0.75)
dev.off()

#informal

aaa=seq(1:nw)
ylim = c(0,1)
plot(x = ts.enddate, y =matrix(ei10FF[,1],ncol=1), type = "l", main = "Pricing performance PCA", xlab = "Date", ylab = "Pricing Performance", ylim = ylim)
lines(x  =ts.enddate, y = ei10FF[,2],col=2)
lines(x  =ts.enddate, y = ei10FF[,3],col=3)
lines(x  =ts.enddate, y = ei10FF[,4],col=4)
lines(x  =ts.enddate, y = ei10FF[,5],col=5)



# formal
pdf('T24_GC_FACTORS_FF5.pdf')
plot(x=ts.enddate,y=ei10FF[,1],type="l",ylim=c(0,1),
     main="Canonical Correlations: Factors \n local PCA vs FF5  (T=24)" ,
     xlab="Date",ylab="Canonical Correlation" )
lines(x=ts.enddate,y=ei10FF[,2],col=2)
lines(x=ts.enddate,y=ei10FF[,3],col=3)
lines(x=ts.enddate,y=ei10FF[,4],col=4)
lines(x=ts.enddate,y=ei10FF[,5],col=5)
abline(v = rec[which(rec > 0)], col = "grey80")
legend(ts.enddate[241],0.6,c("gc=1", "gc=2","gc=3","gc=4","gc=5","econ-fin crises"), lwd=c(5,5), col=c(1,2,3,4,5,"grey"), y.intersp=0.75)
dev.off()

FIG OA7:
  pdf('SDFT24.pdf')
ylim = c(-3, 3)
plot(x = ts.enddate[(window+1):windowu], y = sdfT[2:nw],col="black",lwd=1, type = "l", main = "SDF: local PCA vs. constant PCA \n(T=24,r=time_var)", xlab = "Date", ylab = "SDF", ylim = ylim)
points(x = ts.enddate[(window+1):windowu], y =sdfu[2:nw,2],col=3)
lines(x = ts.enddate[(window+1):windowu], y =t(sdfT_up[2:nw]),col=2)
lines(x = ts.enddate[(window+1):windowu], y =t(sdfT_do[2:nw]),col=2)
abline(v = ts.enddate[ which(rec[25:480]>0)], col = c00)
abline(v = ts.enddate[which(data_nt$REC[222:678]>0)], col = c11)
legend(ts.enddate[(window+270):(window+270)],-1,cex=0.5,c("local PCA unb","constant PCA",  "CI 95% local PCA", "Financial Crises", "NBER"), lwd=c(1.5,1.5), col=c(1,3,2,c00,c11), y.intersp=0.75)
dev.off()

FIG OA8:
go to section #  spectrum of SDF 
of Empirics_JPE_MS20210421.R 
  
  
  
pdf('T24_SDF_spectral_K1_7Feb23.pdf')
plot(x=nw_d$x,y=nw_d$y,main="SDF: Spectral Analysis \n  local PCA  vs. constant PCA  (T=24,r=1)" ,
     xlab="frequency",ylab="SDF spectrum", type="l",col = 1,lwd=3,ylim=c(0.005,0.06)) # Plot 1st histogram using a transparent color
lines(x=nw_du$x,y=nw_du$y, col=3,lwd=3) 
rect(xleft = (2*pi)/32, xright = (2*pi)/6, ybottom = par("usr")[3], ytop = par("usr")[4], 
     border = NA, col = adjustcolor("blue", alpha = 0.3))
legend(1.25,0.05,c("local PCA unb", "constant PCA","business cycle band"), lwd=c(5,5), col=c(1,3, adjustcolor("blue", alpha = 0.3)), y.intersp=0.75)

dev.off()



FIG OA9:
pdf('SDFT24COR.pdf')
ylim = c(0, 1.5)
plot(x = ts.enddate[(window+1):windowu], y = sdf_vol[2:nw],col="black",lwd=1, type = "l", main = "SDF: Correlation and Volatiliy (T=24)", xlab = "Date", ylab = "correlation and volatility", ylim = ylim)
lines(x = ts.enddate[(window+1):windowu], y =sdf_corr[2:nw],col=2)
abline(h=mean(sdfu_vol[1,2]),col=3)
abline(v = ts.enddate[ which(rec[25:480]>0)], col = c00)
abline(v = ts.enddate[which(data_nt$REC[222:678]>0)], col = c11)
legend(ts.enddate[(window+270):(window+270)],1.5,cex=0.5,c("vol local PCA","cor SDF", "vol cons PCA", "Financial Crises", "NBER"), lwd=c(1.5,1.5), col=c(1,2,3,c00,c11), y.intersp=0.75)
dev.off()


pdf('SDFT120.pdf')
ylim = c(-3, 3)
plot(x = ts.enddate[(window+1):windowu], y = sdfT[2:nw],col="black",lwd=1, main = "SDF: local PCA vs. constant PCA \n(T=120,r=time_var)", xlab = "Date", ylab = "SDF", ylim = ylim)
points(x = ts.enddate[(window+1):windowu], y =sdfu[2:nw,2],col=3)
lines(x = ts.enddate[(window+1):windowu], y =t(sdfT_up[2:nw]),col=2)
lines(x = ts.enddate[(window+1):windowu], y =t(sdfT_do[2:nw]),col=2)
abline(v = ts.enddate[ which(rec[(25+96):480,2]>0)], col = c00)
abline(v = ts.enddate[which(data_nt$REC[(222+96):678]>0)], col = c11)
legend(ts.enddate[(window+150):(window+150)],-1,cex=0.5,c("local PCA unb","constant PCA",  "CI 95% local PCA", "Financial Crises", "NBER"), lwd=c(1.5,1.5), col=c(1,3,2,c00,c11), y.intersp=0.75)
dev.off()



pdf('SDFT120COR.pdf')
ylim = c(0, 1.5)
plot(x = ts.enddate[(window+1):windowu], y = sdf_vol[2:nw],col="black",lwd=1, type = "l", main = "SDF: Correlation and Volatiliy (T=24)", xlab = "Date", ylab = "correlation and volatility", ylim = ylim)
lines(x = ts.enddate[(window+1):windowu], y =sdf_corr[2:nw],col=2)
abline(h=mean(sdfu_vol[1,2]),col=3)
abline(v = ts.enddate[ which(rec[(25+96):480]>0)], col = c00)
abline(v = ts.enddate[which(data_nt$REC[(222+96):678]>0)], col = c11)
legend(ts.enddate[(window+150):(window+150)],1.5,cex=0.5,c("vol local PCA","cor SDF", "vol cons PCA", "Financial Crises", "NBER"), lwd=c(1.5,1.5), col=c(1,2,3,c00,c11), y.intersp=0.75)
dev.off()

TABLE OA1:
run   #  regresssion SDF on state variables bs
and
run  # Jan effect
of Empirics_JPE_MS20210421.R 


FIG OA10
run # R-squared
of Empirics_JPE_MS20210421.R 


pdf('T24_R2.pdf')
plot(x=ts.enddate,y=r2,type="l",ylim=c(0,1),
     main="R−square: local  PCA vs constant PCA vs  FF5 (T=24)" ,
     xlab="Date",ylab="R-square" )
lines(x=ts.enddate,y=r2FF,col=2)
abline(h = r2ufull, col = 3)
dev.off()


FIGOA11
run          # variance decomposition
of Empirics_JPE_MS20210421.R 

ylim = c(0, 3)
plot(x = ts.enddate, y = con_n_ave,col="black",lwd=1, type = "l",
     main = "Factors Variance  Attribution: (T=24)", xlab = "Date", ylab = "Variance Components", ylim = ylim)
lines(x = ts.enddate, y =con_lam_n_ave,col=2)
lines(x = ts.enddate, y =con_sig_n_ave,col=3)
lines(x = ts.enddate, y =conFF_n_ave,col=4)
abline(v = ts.enddate[ which(rec[(25):480]>0)], col = c00)
abline(v = ts.enddate[which(data_nt$REC[(222):678]>0)], col = c11)
legend(ts.enddate[(window+150):(window+150)],1.5,cex=0.5,c("tot var contr","loadings contr" , "fact var contr", "total var FF", "Financial Crises", "NBER"), lwd=c(1.5,1.5), col=c(1,2,3,4,c00,c11), y.intersp=0.75)


TABLE OA2  T=120
See instructions Table 3 main 

Out-of-Sample  SDF
abs(apply(dmSS_uncond_bal_oos2[,(Thalf-window+2):240],1,mean)/apply(dmSS_cond_bal_oos[,(Thalf-window+2):240],1,mean))
mean(abs(apply(dmSS_uncond_bal_oos2[,(Thalf-window+2):240],1,mean)/(matrix(rep(1,10),10,1)%*%mean(dmSS_cond_bal_oos_opt[,(Thalf-window+2):240]))))
abs(apply(dmSS_uncond_bal_oos2[,(Thalf-window+2):240],1,mean)/apply(dmSS_cond_unbal_oos2[,(Thalf-window+2):240],1,mean))
mean(abs(apply(dmSS_uncond_bal_oos2[,(Thalf-window+2):240],1,mean)/(matrix(rep(1,10),10,1)%*%mean(dmSS_cond_unbal_oos2_opt[,(Thalf-window+2):240]))))
In-Sample SDF
apply(dmSS_uncond_bal_is[,(Thalf-window+2):240],1,mean)/apply(dmSS_cond_bal_is[,(Thalf-window+2):240],1,mean)
abs(apply(dmSS_uncond_bal_is[,(Thalf-window+2):240],1,mean)/matrix(rep(1,10),10,1)%*%mean(dmSS_cond_bal_is_opt[1,(Thalf-window+2):240]))
apply(dmSS_uncond_bal_is[,(Thalf-window+2):240],1,mean)/apply(dmSS_cond_unbal_is[,(Thalf-window+2):240],1,mean)
abs(apply(dmSS_uncond_bal_is[,(Thalf-window+2):240],1,mean)/matrix(rep(1,10),10,1)%*%mean(dmSS_cond_unbal_is_opt[1,(Thalf-window+2):240]))
Out-of-Sample  RP
abs(apply(dmSS_delta_uncond_bal_oos2[,(Thalf-window+2):240],1,mean)/apply(dmSS_delta_cond_bal_oos_45[,(Thalf-window+2):240],1,mean))
mean(abs(apply(dmSS_delta_uncond_bal_oos2[,(Thalf-window+2):240],1,mean)/(matrix(rep(1,10),10,1)%*%mean(dmSS_delta_cond_bal_oos_45_opt[,(Thalf-window+2):240])))
     abs(apply(dmSS_delta_uncond_bal_oos2[,(Thalf-window+2):240],1,mean)/apply(dmSS_delta_cond_unbal_oos2_45[,(Thalf-window+2):240],1,mean))
     mean(abs(apply(dmSS_delta_uncond_bal_oos2[,(Thalf-window+2):240],1,mean)/(matrix(rep(1,10),10,1)%*%mean(dmSS_delta_cond_bal_oos2_45_opt[,(Thalf-window+2):240])))
In-Sample RP
          apply(dmSS_delta_uncond_bal_is[,(Thalf-window+2):240],1,mean)/apply(dmSS_delta_cond_bal_is_45[,(Thalf-window+2):240],1,mean)
          abs(apply(dmSS_delta_uncond_bal_is[,(Thalf-window+2):(nw-2*window)],1,mean)/matrix(rep(1,10),10,1)%*%mean(dmSS_delta_cond_bal_is_45_opt[1,(Thalf-window+2):(nw-2*window)]))
          apply(dmSS_delta_uncond_bal_is[,(Thalf-window+2):240],1,mean)/apply(dmSS_delta_cond_unbal_is_45[,(Thalf-window+2):240],1,mean)
          abs(apply(dmSS_delta_uncond_bal_is[,(Thalf-window+2):(nw-2*window)],1,mean)/matrix(rep(1,10),10,1)%*%mean(dmSS_delta_cond_unbal_is_45_opt[1,(Thalf-window+2):(nw-2*window)]))
          
FIG OA12-OA13

run #  formal and informal plots   PE SDF IS and OOS



change  K to get all plots - here us K=7 and T=120

c1 <- rgb(173,216,230, max = 255, alpha = 150, names = "lt.blue")
c2 <- rgb(255,192,203, max = 255, alpha = 150, names = "lt.pink")
c3 <- rgb(144,238,144, max = 255, alpha = 150, names = "lt.green")
c4 <- rgb(255,0,0, max = 255, alpha = 150, names = "lt.red")
c11 <- rgb(173,216,230, max = 255, alpha = 255, names = "lt.blue")
c33 <- rgb(144,238,144, max = 255, alpha = 255, names = "lt.green")
c44 <- rgb(255,0,0, max = 255, alpha = 255, names = "lt.red")
c22 <- rgb(255,192,203, max = 255, alpha = 255, names = "lt.pink")

hSDF3 <- hist(totSDF_ubpoos[,7], breaks = 30 , freq= FALSE)
hSDF2 <- hist(totSDF_cbpoos[,7], breaks = 30 ,  freq=FALSE)
hSDF <- hist(totSDF_cunpoos[,7], breaks = 30 ,  freq=FALSE)


pdf('T120_SDF_K7_9Jan23.pdf')
plot(hSDF,  main="
            Pricing Performance: Pricing Errors SDF
\n Out-of-Sample: local PCA  vs. constant PCA  (T=120,r=7) \n" ,#xlim=c(-3,3),ylim=c(0,25),
     xlab="Out-of-Sample Pricing Errors SDF",col = 1 , freq = FALSE) # Plot 1st histogram using a transparent color
plot(hSDF3,  col = c4, add = TRUE , freq=FALSE) # Add 2nd histogram using different color
plot(hSDF2,  col = c3, add = TRUE , freq=FALSE) # Add 2nd histogram using different color

PLOT OA14-OA17

T=24 and 120
K=1,3,7,10

pdf('T120_45_K10_9Jan23.pdf')
plot(totLamPrem_cunpoos2[,10],totX2,  main="
            Pricing Performance: Expected Return
\n   Out-of-Sample - local PCA unbalanced (T=120, r=10) \n", #,xlim=c(-3,3),ylim=c(0,25),
     xlab="Model-Implied Expected Return",ylab="Average Return",   col = c1) # Plot 1st histogram using a transparent color
abline(coef = c(0,1),col=1,lwd=5) 
legend(0,0.04,c("local PCA unb", "45 degrees line"), lwd=c(5,5), col=c(c11,1), y.intersp=0.75)
dev.off()






pdf('T120_45bal_K10_9Jan23.pdf')
plot(totLamPrem_cbpoos[,10],totXbal2,  main="
            Pricing Performance: Expected Return
\n   Out-of-Sample: local PCA  bal vs. constant PCA  (T=120,r=10) \n", #,xlim=c(-3,3),ylim=c(0,25),
     xlab="Model-Implied Expected Return",ylab="Average Return",   col = c33) # Plot 1st histogram using a transparent color
points(totLamPrem_ubpoos[,10],totXbal2,  col = c44) # Add 2nd histogram using different color
abline(coef = c(0,1),col=1,lwd=5) 
legend(0.003,0.02,c("local PCA bal","constant PCA", "45 degrees line"), lwd=c(5,5), col=c(c33,c44,1), y.intersp=0.75)
dev.off()


TABLE OA3-OA4

T=24 and T=120


# correlations is
t(cor(totLamPrem_cbis,totXbal2is))
(cor(totLamPrem_cbis_tv,totXbal2is))

t(cor(totLamPrem_ubis,totXbal2is))


t(cor(totLamPrem_cunis,totX2is))
(cor(totLamPrem_cunis_tv,totX2is))

# correlations oos
t(cor(totLamPrem_cbpoos,totXbal2))
t(cor(totLamPrem_cbpoos_tv,totXbal2))

t(cor(totLamPrem_ubpoos2,totXbal2))

t(cor(totLamPrem_cunpoos,totX2))
t(cor(totLamPrem_cunpoos_tv,totX2))

TABLES  OA5-OA6

run # PORTFOLIO
preliminary 10126-10263
unconditional 10272-10755
parallel 10756-10936
cond bal and con unbal 11234-11452

T=24
OOS
cond unbal
  > apply(SR[(Thalf+window):(nw-window-2),],2,mean)
con bal    
> apply(SR2[(Thalf+window):(nw-window-2),],2,mean)
timevarying con bal
>     mean(SRrrr[(Thalf+window):(nw-window-2)])
timevarying con unbal
>        mean(SRrrr2[(Thalf+window):(nw-window-2)])

uncon SR_unc_oos  > SR_unc_oos=sqrt(12)*apply(rrr_unc_oos, 2, mean)/apply(rrr_unc_oos, 2, sd)


IS
con unbal    apply(SRrrrisvec[(Thalf+window):(nw-window-2),],2,mean)
con bal        apply(SRrrris2vec[(Thalf+window):(nw-window-2),],2,mean)
timevarying con unbal    mean(SRrrris[(Thalf+window):(nw-window-2)])
timevarying con bal        mean(SRrrris2[(Thalf+window):(nw-window-2)])

> SR_unc_is=sqrt(12)*apply(rrr_unc_is, 2, mean)/apply(rrr_unc_is, 2, sd)

T=120 same as above but changing window=120

FIGURES OA18-OA21


T=24 and T=120 and changing K=1,3,7,10.
The uncon value is set for K=1 (unconditonal estimate of number factors)

c1 <- rgb(173,216,230, max = 255, alpha = 200, names = "lt.blue")
c2 <- rgb(255,192,203, max = 255, alpha = 30, names = "lt.pink")
c3 <- rgb(144,238,144, max = 255, alpha = 100, names = "lt.green")
c4 <- rgb(255,0,0, max = 255, alpha = 80, names = "lt.red")





hSR <- hist(SR[(Thalf-window+2):(nw-window-2),1], breaks = 30 , plot = FALSE)
hSR2 <- hist(SR2[(Thalf-window+2):(nw-window-2),1], breaks = 30 , plot = FALSE)



 
pdf('T120_SR_K1_9Jan23.pdf')
plot(hSR,  main="
            Portfolio Performance: Sharpe Ratio - Tangency Portolios
\n   Out-of-Sample: local PCA  vs. constant PCA  (T=120) \n" ,xlim=c(-0.5,1),ylim=c(0,25),
     xlab="Out-of-Sample Sharpe Ratio (p.a.)",col = c1) # Plot 1st histogram using a transparent color
plot(hSR2,  col = c3, add = TRUE) # Add 2nd histogram using different color
abline(v=0.579,col=2,lwd=5)
legend(-0.5,20,c("local PCA unb","local PCA bal", "constant PCA"), lwd=c(5,5), col=c(c1,c3,2), y.intersp=0.75)
  dev.off()


hSR <- hist(SRrrrisvec[(Thalf-window+2):(nw-window-2),1], breaks = 30 , plot = FALSE)
hSR2 <- hist(SRrrris2vec[(Thalf-window+2):(nw-window-2),1], breaks = 30 , plot = FALSE)




pdf('T120_SR_K1_is_9Jan23.pdf')
plot(hSR,  main="
            Portfolio Performance: Sharpe Ratio - Tangency Portolios
\n In-Sample: local PCA  vs. constant PCA  (T=120) \n" ,xlim=c(-0.5,1.5),ylim=c(0,25),
     xlab="In-Sample Sharpe Ratio (p.a.)",col = c1) # Plot 1st histogram using a transparent color
plot(hSR2,  col = c3, add = TRUE) # Add 2nd histogram using different color
abline(v=0.459,col=2,lwd=5)
legend(-0.5,20,c("local PCA unb","local PCA bal", "constant PCA"), lwd=c(5,5), col=c(c1,c3,2), y.intersp=0.75)
dev.off()



FIGURE OA22
run #    empirics  locally strong factors


for R2u below  and run # constant bal 

#  this is TS R2

reg=lm(HKM_alined[1:467,3]~ts.factorsu[1:467,,1])
R2u=var(reg$fitted.values)/var(HKM_alined[1:467,3])
beta2u=reg$coefficients
R2vecu=(diag(reg$coefficients[2:11]^2))%*%matrix(diag(var(ts.factorsu[,,1])),10,1)/var(HKM_alined[1:467,3])



# this is XS R2

reg=lm(X_balanced[1:467,]~ts.factorsu[1:467,,1])
regxsu=lm(X_balanced_mean~t(reg$coefficients[2:11,]))
R2xu=var(regxsu$fitted.values)/var(X_balanced_mean)

facplushkmu=cbind(ts.factorsu[1:467,,1],HKM[1:467,3])
reg1=lm(X_balanced[1:467,]~facplushkmu)
regxs1u=lm(X_balanced_mean~t(reg1$coefficients[2:12,]))
R2x1u=var(regxs1u$fitted.values)/var(X_balanced_mean)

Ftestu=(R2x1u-R2xu)/((1-R2x1u)/(N-12)  )
Ftestpvalu=1-pchisq(Ftestu,1)




pdf('HKM_R2_unbalanced_17Jan23.pdf')
plot(x=ts.enddate[1:(nw-window)],type="l", y = R2[1:(nw-window)],
     main="Locally-Strong Factors: Local PCA (unb) vs Intermediary Capital  (T=24)",ylim=c(0,1),
     xlab="Date",ylab="R-square",col = 1)#,ylim=c(-0.002,0.003)) # Plot 1st histogram using a transparent color
lines(ts.enddate[1:(nw-window)], type="l", y = R2vec[1:(nw-window),1],
      col = 3, add = TRUE , freq=FALSE) # Add 2nd histogram using different color
lines(x = ts.enddate[1:(nw-window)], y = R2vec[1:(nw-window),2],  col = 4, add = TRUE , freq=FALSE) # Add 2nd histogram using different color
abline(h=R2u,col=2,lwd=3)
abline(v = rec[which(rec > 0)], col = "gray90")
legend(ts.enddate[1],0.4,c("total Rsquare", "Rsquare(1)", "Rsquare(2)", "constant Rsquare"), lwd=c(5,5), col=c(1,3,4,2), y.intersp=0.75)
dev.off()


pdf('HKM_R2_balanced_17Jan23.pdf')
plot(x=ts.enddate[1:(nw-window)],type="l", y = R2b[1:(nw-window)],
     main="Locally-Strong Factors: Local PCA (bal) vs Intermediary Capital  (T=24)",ylim=c(0,1),
     xlab="Date",ylab="R-square",col = 1)#,ylim=c(-0.002,0.003)) # Plot 1st histogram using a transparent color
lines(ts.enddate[1:(nw-window)], type="l", y = R2vecb[1:(nw-window),1],
      col = 3, add = TRUE , freq=FALSE) # Add 2nd histogram using different color
lines(x = ts.enddate[1:(nw-window)], y = R2vecb[1:(nw-window),4],  col = 4, add = TRUE , freq=FALSE) # Add 2nd histogram using different color
abline(h=R2u,col=2,lwd=3)
abline(v = rec[which(rec > 0)], col = "gray90")
legend(ts.enddate[1],0.4,c("total Rsquare", "Rsquare(1)", "Rsquare(4)", "constant Rsquare"), lwd=c(5,5), col=c(1,3,4,2), y.intersp=0.75)
dev.off()

 Comparison  with Ian Martin measure - here I need to fix the rotation (obvious)
 
run # market return analyis 
of Empirics_JPE_ MS 20210421.R
 
FIG OA23

r2h <- hist(12*r2[(193+4):(193+191+4)], breaks = 30 , plot = FALSE)
imh <- hist(newdata[,3], breaks = 30 , plot = FALSE)
c1 <- rgb(173,216,230, max = 255, alpha = 120, names = "lt.blue")
c2 <- rgb(255,192,203, max = 255, alpha = 30, names = "lt.pink")
c3 <- rgb(144,238,144, max = 255, alpha = 30, names = "lt.green")
c4 <- rgb(1,1,255, max = 255, alpha = 80, names = "lt.bo")
plot(r2h,  main="HISTOGRAM and PDF: \nDREFUS PORTFOLIO RETURN" ,xlim=c(-15,15),
     xlab="Monthly Returns",col = c1) # Plot 1st histogram using a transparent color

FIG OA24

# now make units of r2 as IM (fix rotation)

r2s=matrix(NA,nw,1)
r2s=mean(newdata[,3])+sd(newdata[,3])*(r2- mean(r2))/sd(r2)


pdf('MRP_LOCAL_MKT_MARTIN_timeseries_17Jan23.pdf')
plot(x=ts.enddate[(193+3):(193+191+3)],y=12*r2s[(193+3):(193+191+3)],type="l",ylim=c(-30,30),
     main="Expected Market Return: \n Local PCA (rescaled)  vs Option-Implied vs Market Factor" ,
     xlab="Monthly Returns",ylab="date"
) # Add 2nd histogram using different color
lines(x=ts.enddate[(193+3):(193+191+3)],newdata[,3],col=2)
lines(x=ts.enddate[(193+3):(193+191+3)],y=12*r1[(193+3):(193+191+3)],col=3) # Add 2nd histogram using different color
abline(v = rec[which(rec > 0)], col = "grey80")
legend(ts.enddate[(193+3)],-20,c("local PCA (resc)", "Option-Implied","Market Factor"), lwd=c(5,5), col=c(1,2,3), y.intersp=0.75)
dev.off() 

TABLE OA7

run  # market return prediction  

Section OA15.7 Large Caps - repeat the above but using SP500 dataset.

Section OA16.1

first MC experiment:
  
Tables OA11-OA15

Figures  OA37-OA48

run # START CONSTANT NUMBER OF FACTORS 
of Montecarlo_numberoffactors_JPE_MS20210421.R


run #  CLT of factors estimates  
of Montecarlo_numberoffactors_JPE_MS20210421.R


second MC experiment:
  
run #START  TIME VARYING  NUMBER OF FACTORS
 of Montecarlo_numberoffactors_JPE_MS20210421.R

  Table OA16

third  MC experiment:
  
  run 1 to 1913
of  Montecarlo_JPE_MS20210421.R

  Tables OA17-18-19 and Figures OA49-OA54
  
  variation of third  MC experiment:
    
  Tables OA20-21-22

Like Table 1  main with 2.5 times the sd of error term:  in line  "X = common + e*sqrt(ss)*2.5"

END
